home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / emacs_src_18_58.lha / emacs-18.58 / src / amiga_rexx.c < prev    next >
C/C++ Source or Header  |  1992-08-16  |  7KB  |  241 lines
  1. #include "SimpleRexx.h"
  2. #include <proto/exec.h>
  3. #undef NULL
  4. #include "config.h"
  5. #include "lisp.h"
  6.  
  7. #include "amiga.h"
  8.  
  9. static AREXXCONTEXT far handle;
  10.  
  11. #define REXXSIZE 32
  12.  
  13. static struct {
  14.   int rc; /* 0 for commands, <> 0, for errors */
  15.   union {
  16.     struct { int id; int code; } error; /* Of failed messages */
  17.     struct RexxMsg *msg; /* Received command */
  18.   } u;
  19. } pending_rexx_msgs[REXXSIZE];
  20. static int pending_rexx_num, pending_rexx_in, pending_rexx_out;
  21. static int amiga_arexx_initialized;
  22.  
  23. static struct {
  24.   struct RexxMsg *msg;
  25.   int id;
  26. } sent_rexx_msg[REXXSIZE];
  27. static int sent_rexx_id;
  28.  
  29. int check_arexx(int force, int kbd)
  30. {
  31.   struct RexxMsg *rmsg;
  32.   int msg_received = FALSE;
  33.  
  34.   while (rmsg = GetARexxMsg(handle))
  35.     {
  36.       msg_received = TRUE;
  37.  
  38.       if (rmsg->rm_Node.mn_Node.ln_Type == NT_REPLYMSG)
  39.     {
  40.       int i;
  41.  
  42.       /* The message has been returned, remove it from sent messages */
  43.       for (i = 0; i < REXXSIZE && sent_rexx_msg[i].msg != rmsg; i++) ;
  44.       if (i < REXXSIZE) sent_rexx_msg[i].msg = 0;
  45.  
  46.       if (rmsg->rm_Result1)
  47.         {
  48.           /* There was an error, add it to pending_rexx_msgs */
  49.           if (pending_rexx_num != REXXSIZE)
  50.         {
  51.           pending_rexx_num++;
  52.           pending_rexx_msgs[pending_rexx_in].u.error.id =
  53.             i < REXXSIZE ? sent_rexx_msg[i].id : 0;
  54.           pending_rexx_msgs[pending_rexx_in].u.error.code = rmsg->rm_Result2;
  55.           pending_rexx_msgs[pending_rexx_in].rc = rmsg->rm_Result1;
  56.           pending_rexx_in = (pending_rexx_in + 1) % REXXSIZE;
  57.         }
  58.           /* else ignore this error */
  59.         }
  60.       DeleteARexxMsg(handle, rmsg);
  61.     }
  62.       else
  63.     {
  64.       if (pending_rexx_num == REXXSIZE)
  65.         {
  66.           /* Oops! Throw out message */
  67.           SetARexxLastError(handle, rmsg, "Emacs too busy");
  68.           ReplyARexxMsg(handle, rmsg, 0, 20);
  69.         }
  70.       else
  71.         {
  72.           pending_rexx_num++;
  73.           pending_rexx_msgs[pending_rexx_in].u.msg = rmsg;
  74.           pending_rexx_msgs[pending_rexx_in].rc = 0;
  75.           pending_rexx_in = (pending_rexx_in + 1) % REXXSIZE;
  76.         }
  77.     }
  78.     }
  79.   if (kbd && amiga_arexx_initialized && (msg_received || force && pending_rexx_num > 0))
  80.     {
  81.       enque(AMIGASEQ, FALSE); enque('X', FALSE);
  82.     }
  83.   return msg_received;
  84. }
  85.  
  86. DEFUN ("amiga-arexx-wait", Famiga_arexx_wait, Samiga_arexx_wait, 0, 0, 0,
  87.   "Wait for an ARexx event (command or reply) before proceeding.")
  88.   ()
  89. {
  90.     while (!check_arexx(FALSE, FALSE)) Wait(ARexxSignal(handle));
  91. }
  92.  
  93. DEFUN ("amiga-arexx-check-command",
  94.        Famiga_arexx_check_command, Samiga_arexx_check_command, 1, 1, 0,
  95.        "Return t if command ID has finished, nil otherwise.")
  96.      (id)
  97. {
  98.   int i, nid;
  99.  
  100.   CHECK_NUMBER (id, 0);
  101.   nid = XUINT (id);
  102.  
  103.   for (i = 0; i < REXXSIZE && (!sent_rexx_msg[i].msg || nid != sent_rexx_msg[i].id);
  104.        i++) ;
  105.  
  106.   return i == REXXSIZE ? Qnil : Qt;
  107. }
  108.  
  109. DEFUN ("amiga-arexx-get-event", Famiga_arexx_get_event, Samiga_arexx_get_event,
  110.   0, 0, 0,
  111.   "Returns next arexx event, either an error or a command to execute.\n\
  112. If no event is waiting, nil is returned.\n\
  113. Errors are returned as a (id-of-failed-command severity error-code) list\n\
  114. (Don't answer these events!).\n\
  115. Commands are strings sent by an arexx process. They should be answered via\n\
  116. amiga-arexx-reply. amiga-arexx-get-event will always return the same command\n\
  117. till you do so.")
  118.   ()
  119. {
  120.   struct RexxMsg *rmsg;
  121.  
  122.   check_arexx(FALSE, FALSE);
  123.   if (pending_rexx_num)
  124.     if (pending_rexx_msgs[pending_rexx_out].rc)
  125.       {
  126.     Lisp_Object id, error, rc;
  127.     Lisp_Object res;
  128.  
  129.     XSET (id, Lisp_Int, pending_rexx_msgs[pending_rexx_out].u.error.id);
  130.     XSET (error, Lisp_Int,
  131.           pending_rexx_msgs[pending_rexx_out].u.error.code & VALMASK);
  132.     XSET (rc, Lisp_Int, pending_rexx_msgs[pending_rexx_out].rc & VALMASK);
  133.     res = Fcons (id, Fcons (rc, Fcons (error, Qnil)));
  134.  
  135.     pending_rexx_out = (pending_rexx_out + 1) % REXXSIZE;
  136.     pending_rexx_num--;
  137.  
  138.     return res;
  139.       }
  140.     else return build_string(ARG0(pending_rexx_msgs[pending_rexx_out].u.msg));
  141.  
  142.   return Qnil;
  143. }
  144.  
  145. DEFUN ("amiga-arexx-reply", Famiga_arexx_reply, Samiga_arexx_reply,
  146.   2, 2, 0,
  147. "Replies to the first arexx message (the one got via amiga-arexx-get-event)\n\
  148. with RC as return code.\n\
  149. If RC=0, TEXT is the result, otherwise it is the error text. It can be nil.")
  150.   (rc, text)
  151. {
  152.     int retcode;
  153.     char *result;
  154.     struct RexxMsg *rmsg;
  155.     int ok = TRUE;
  156.  
  157.     if (!pending_rexx_num) error("No ARexx message to reply to.");
  158.     CHECK_NUMBER(rc, 0);
  159.     retcode = XINT(rc);
  160.  
  161.     if (!NULL (text))
  162.     {
  163.     CHECK_STRING(text, 0);
  164.     result = XSTRING (text)->data;
  165.     }
  166.     else result = 0;
  167.  
  168.     if (pending_rexx_msgs[pending_rexx_out].rc)
  169.       error("You can't answer an error !");
  170.     rmsg = pending_rexx_msgs[pending_rexx_out].u.msg;
  171.     pending_rexx_out = (pending_rexx_out + 1) % REXXSIZE;
  172.     pending_rexx_num--;
  173.  
  174.     if (retcode && result) 
  175.     ok = SetARexxLastError(handle, rmsg, result);
  176.     ReplyARexxMsg(handle, rmsg, result, retcode);
  177.  
  178.     if (!ok) error("Failed to set ARexx error message.");
  179.  
  180.     return Qnil;
  181. }
  182.  
  183. DEFUN ("amiga-arexx-send-command", Famiga_arexx_send_command, Samiga_arexx_send_command, 
  184.   1, 2, "sARexx command: \n\
  185. P",
  186.   "Sends a command to ARexx for execution.\n\
  187. If the second arg is non-nil, the command is directly interpreted.\n\
  188. Returns an integer that uniquely identifies this message (for use in ???).")
  189.   (str, as_file)
  190. {
  191.   struct ARexxMsg *rmsg;
  192.   int i;
  193.   Lisp_Object id;
  194.  
  195.   /* Find a free slot for message */
  196.   for (i = 0; i < REXXSIZE && sent_rexx_msg[i].msg; i++) ;
  197.   if (i == REXXSIZE) error("Too many arexx commands pending (max %d)", REXXSIZE);
  198.  
  199.   CHECK_STRING (str, 0);
  200.   if (!(rmsg = SendARexxMsg(handle, XSTRING (str)->data, !NULL (as_file))))
  201.     error("Failed to send command to ARexx.");
  202.  
  203.   sent_rexx_msg[i].msg = rmsg;
  204.   sent_rexx_id = (sent_rexx_id + 1) & VALMASK;
  205.   sent_rexx_msg[i].id = sent_rexx_id;
  206.  
  207.  
  208.   XSET (id, Lisp_Int, sent_rexx_id);
  209.   return id;
  210. }
  211.  
  212. void init_amiga_rexx(void)
  213. {
  214.     extern ULONG inputsig;
  215.     int i;
  216.  
  217.     handle = InitARexx("Emacs", "elx");
  218.     inputsig |= ARexxSignal(handle);
  219.     pending_rexx_num = pending_rexx_in = pending_rexx_out = 0;
  220.     for (i = 0; i < REXXSIZE; i++) sent_rexx_msg[i].msg = 0;
  221.     sent_rexx_id = 0;
  222. }
  223.  
  224. void cleanup_amiga_rexx(void)
  225. {
  226.     FreeARexx(handle);
  227. }
  228.  
  229. void syms_of_amiga_rexx(void)
  230. {
  231.     DEFVAR_BOOL ("amiga-arexx-initialized", &amiga_arexx_initialized,
  232.          "Set this to t when Emacs is ready to respond to ARexx messages.\n\
  233. (ie C-\ X causes all pending ARexx messages to be answered)");
  234.     amiga_arexx_initialized = 0;
  235.     defsubr(&Samiga_arexx_send_command);
  236.     defsubr(&Samiga_arexx_reply);
  237.     defsubr(&Samiga_arexx_get_event);
  238.     defsubr(&Samiga_arexx_check_command);
  239.     defsubr(&Samiga_arexx_wait);
  240. }
  241.